(FILECREATED "26-OCT-73 19:22:18" S-DICT)


  (LISPXPRINT (QUOTE DICTVARS)
              T)
  (RPAQQ DICTVARS ((* DICTIONARY CREATION - REALLY NEEDS WORK TO MAKE 
                      SURE INTERFACES WITH ADVISING, BREAKING, ETC WILL 
                      ALL WORK)
          (FNS ENTER LOOKUP MAKTAB WRITESOME PUSHCAR WRITEALL WRITEDICT 
               WRITESOME1)
          (VARS DICTIONARYLST)))

(* DICTIONARY CREATION - REALLY NEEDS WORK TO MAKE SURE INTERFACES
WITH ADVISING, BREAKING, ETC WILL ALL WORK)

(DEFINEQ

(ENTER
  [LAMBDA (PTR DICT VAL)

          (* ENTER value into dictionary -
          VAL is the value, PTR is the return from LOOKUP 
          (which should be (LIST ARGS)) and DICT is the 
          dictionary in which PTR is contained 
          (needed to get the file name, and the number in core 
          verses the max in core allowed))


    (FRPLACA (CDR DICT)
             (ADD1 (CADR DICT)))                (* Bump the incore 
                                                counter)
    (FRPLACD PTR (CONS NIL VAL))
    (WRITESOME DICT])

(LOOKUP
  [LAMBDA (VARS DICT)                           (* LOOKUP VARS on the 
                                                dictionary DICT)
    (AND DICT (PROG ((FND (SASSOC VARS (CDDDR DICT)))
                     FIL)                       (* Use saccoc to find 
                                                entry, if any)
                    (COND
                      ((NOT FND)                (* If no entry, just 
                                                insert empty entry in 
                                                the dictionary and 
                                                return)
                        (SETQ FND (LIST VARS))
                        (FRPLACD (CDDR DICT)
                                 (CONS FND (CDDDR DICT)))
                        (RETURN FND)))
                    [PUSHCAR (CDDR DICT)
                             (NLEFT (CDDR DICT)
                                    1
                                    (FMEMB FND (CDDDR DICT]
                                                (* MOVE the found entry 
                                                to the front of the 
                                                dictionary)
                    (COND
                      ((NOT (CDR FND))

          (* If no file pointer, then this was an empty entry 
          (only possible for an aborted computation))


                        (RETURN FND))
                      ((NOT (CDDR FND))
                        (COND
                          ((NOT (CADR FND))

          (* No value, no ptr, but a ptr place -- this is a 
          funny situation again, but might happen if abort 
          occurs)


                            (FRPLACD FND NIL)
                            (RETURN FND)))

          (* Read in from file, bump incore counter, and check 
          if too many incore, writing outsome;
          then return the value)


                        (SFPTR [SETQ FIL (OR (OPENP (CAR DICT))
                                             (IOFILE (CAR DICT]
                               (CADR FND))
                        (FRPLACD (CDR FND)
                                 (READ FIL))
                        (FRPLACA (CDR DICT)
                                 (ADD1 (CADR DICT)))
                        (WRITESOME DICT)
                        (RETURN FND))
                      (T                        (* It's already in core)
                         (RETURN FND])

(MAKTAB
  [LAMBDA (FN MAXCORE)

          (* Fix up FN so that it uses a dictionary called FIL 
          (which is also the file name that it uses) -
          If FIL is NIL, use the FN name -
          MAXCORE is the maximum number of dictionary entries 
          that can reside in core)


    (PROG [(VARS (ARGLIST FN))
           (FIL (PACK (LIST (NAMEFIELD FN)
                            (QUOTE ".DICT"]
          (COND
            ((MEMB FN DICTIONARYLST)
              (ERROR FN "ALREADY HAS A DICTIONARY")))
          [COND
            ((CDR VARS)
              (SETQ VARS (CONS (QUOTE LIST)
                               VARS)))
            (T (SETQ VARS (CAR VARS]

          (* VARS will be the expression that is to be looked 
          up -
          Usually (LIST <ARGLIST FN>) but if there is only one 
          ARG to FN, will use it alone)


          (VIRGINFN FN T)

          (* The function will look like -
          (tem← (LOOKUP <ARGS> <DICT>)) 
          (if (CDR TEM) then (RETURN 
          (CDDR TEM)) else <compute function> 
          (ENTER TEM FN !VALUE)))


          [ADVISE FN (QUOTE BIND)
                  (LIST (LIST (QUOTE TEM)
                              (LIST (QUOTE LOOKUP)
                                    VARS FN]
          [ADVISE FN (QUOTE BEFORE)
                  (QUOTE (COND
                           ((CDR TEM)
                             (RETURN (CDDR TEM]
          [ADVISE FN (QUOTE AFTER)
                  (LIST (QUOTE COND)
                        (LIST (QUOTE (NOT (CDR TEM)))
                              (LIST (QUOTE ENTER)
                                    (QUOTE TEM)
                                    FN
                                    (QUOTE !VALUE]
                                                (* Open FN file, and set
                                                up incore dictionary)
          (RPAQ DICTIONARYLST (CONS FN DICTIONARYLST))
          (/SET FN (COND
                  [(INFILEP (PACK (LIST FN ".INDEX")))
                    (READFILE (PACK (LIST FN ".INDEX"]
                  (T (LIST (IOFILE (OR (INFILEP FIL)
                                       (OUTFILEP FIL)))
                           0
                           (OR MAXCORE 10])

(WRITESOME
  [LAMBDA (DICT CNT)

          (* If the number of incore entries exceeds the max 
          incore entries, look for the first incore entry that 
          is followed by one not in core -
          Delete the incore value (writing it out if it's not 
          already on file), and decrement the incore counter)


    (AND [NOT (ILESSP (CADR DICT)
                      (OR CNT (CADDR DICT]
         (WRITESOME1 (CDDDR DICT))
         (FRPLACA (CDR DICT)
                  (SUB1 (CADR DICT])

(PUSHCAR
  [LAMBDA (L1 L2)

          (* PUSH (CADR L2) after (CAR L1) -
          L2 is a tail of L1 -
          Sort of complicated)


    (OR (EQ L1 L2)
        (PROG (TEM)
              (SETQ TEM (CDR L1))
              (FRPLACD L1 (CDR L2))
              (FRPLACD L2 (CDDR L2))
              (FRPLACD (CDR L1)
                       TEM])

(WRITEALL
  [LAMBDA (DICT)
    (PROG NIL
      LP  (COND
            ((NOT (WRITESOME DICT 0))
              (RETURN))
            (T NIL))
          (GO LP])

(WRITEDICT
  [LAMBDA (FN)
    (COND
      ((NULL FN)
        (MAPC DICTIONARYLST (FUNCTION WRITEDICT)))
      ((MEMB FN DICTIONARYLST)
        (WRITEALL (CAR FN))
        (WRITEFILE (CAR FN)
                   (PACK (LIST FN ".INDEX"])

(WRITESOME1
  [LAMBDA (DICTL)

          (* Tries to write out the last possible DICT element 
          -
          Should be the one referenced least recently)


    (COND
      ((NULL DICTL)                             (* End of list, back up)
        NIL)
      ((WRITESOME1 (CDR DICTL))                 (* First try on CDR, if 
                                                sucessful, return)
        T)
      ((CDDR (CAR DICTL))                       (* This is the last 
                                                entry that has a value 
                                                in it)
        [COND
          ((NULL (CADAR DICTL))

          (* If it hasn't been written out on a file, the ptr 
          field will be NIL)


            (PROG (POS (FIL (CAR DICT)))        (* Get the file name 
                                                from DICT)
                  (SFPTR (SETQ FIL (OR (OPENP FIL (QUOTE OUTPUT))
                                       (IOFILE FIL)))
                         -1)                    (* Set file pointer to 
                                                end of file)
                  (SETQ POS (SFPTR FIL))

          (* And save the pointer so that it can be entered 
          into the DICT)


                  (PRINT (CDDR (CAR DICTL))
                         FIL)                   (* Write out value on 
                                                the file)
                  (FRPLACA (CDAR DICTL)
                           POS)                 (* Insert file pointer 
                                                in dictionary)
              ]
        (FRPLACD (CDR (CAR DICTL))
                 NIL])
)
  (RPAQQ DICTIONARYLST NIL)
STOP